home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / outdef.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  3.8 KB  |  139 lines
  1.       subroutine outdef(ifld,mode,loct,ltype)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine constructs the internal list element for an output
  5. c variable defined on some input card.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=flags 3/15/83
  17.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  18.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  19. c spice version 2g.6  sccsid=blank 3/15/83
  20.       common /blank/ value(200000)
  21.       integer nodplc(64)
  22.       complex cvalue(32)
  23.       equivalence (value(1),nodplc(1),cvalue(1))
  24. c
  25.       integer xxor
  26.       dimension aout(19),aopts(5)
  27.       data aout / 4hv   , 4hvm  , 4hvr  , 4hvi  , 4hvp  , 4hvdb ,
  28.      1            4hi   , 4him  , 4hir  , 4hii  , 4hip  , 4hidb ,
  29.      2            4honoi, 4hinoi, 4hhd2 , 4hhd3 , 4hdim2, 4hsim2,
  30.      3            4hdim3 /
  31.       data aopts / 1hm, 1hr, 1hi, 1hp, 1hd /
  32.       data alprn, acomma, ablnk, aletv / 1h(, 1h,, 1h , 1hv /
  33. c
  34.       if (nodplc(icode+ifld).ne.1) go to 300
  35.       anam=value(ifield+ifld)
  36.       call move(anam,5,ablnk,1,4)
  37.       do 10 i=1,19
  38.       if (xxor(anam,aout(i)).ne.0) go to 10
  39.       idout=i
  40.       go to 20
  41.    10 continue
  42.       go to 300
  43. c
  44. c  further error checking
  45. c
  46.    20 if (mode.ge.3) go to 25
  47. c...  dc or tran
  48.       if ((idout.ne.1).and.(idout.ne.7)) go to 300
  49.       go to 38
  50.    25 if (mode.ge.4) go to 30
  51. c...  ac
  52.       if (idout.ge.13) go to 300
  53.       go to 38
  54.    30 if (mode.eq.5) go to 35
  55. c...  noise
  56.       if ((idout.ne.13).and.(idout.ne.14)) go to 300
  57.       go to 38
  58. c...  distortion
  59.    35 if (idout.lt.15) go to 300
  60.    38 ktype=0
  61.       ltype=idout
  62.       if (idout.lt.7) go to 40
  63.       ktype=1
  64.       ltype=ltype-6
  65.       if (idout.lt.13) go to 40
  66.       ktype=idout-11
  67.       ltype=1
  68. c
  69. c  voltage output
  70. c
  71.    40 id=40+mode
  72.       if (ktype.ne.0) go to 100
  73.       if (nodplc(icode+ifld+1).ne.0) go to 300
  74.       ifld=ifld+1
  75.       n1=value(ifield+ifld)
  76.       if (n1.lt.0) go to 300
  77.       if(n1.gt.9999) go to 300
  78.       n2=0
  79.       adelim=value(idelim+ifld)
  80.       if (adelim.eq.acomma) go to 45
  81.       if (adelim.ne.ablnk) go to 50
  82.    45 if (nodplc(icode+ifld+1).ne.0) go to 300
  83.       ifld=ifld+1
  84.       n2=value(ifield+ifld)
  85.       if (n2.lt.0) go to 300
  86.       if(n2.gt.9999) go to 300
  87.    50 outnam=ablnk
  88.       ipos=1
  89.       call alfnum(n1,outnam,ipos)
  90.       ipos=5
  91.       call alfnum(n2,outnam,ipos)
  92.       call find(outnam,id,loct,0)
  93.       nodplc(loct+2)=n1
  94.       nodplc(loct+3)=n2
  95.       go to 400
  96. c
  97. c  current output
  98. c
  99.   100 if (ktype.ne.1) go to 200
  100.       if (nodplc(icode+ifld+1).ne.1) go to 300
  101.       ifld=ifld+1
  102.       avsrc=value(ifield+ifld)
  103.       achek=avsrc
  104.       call move(achek,2,ablnk,1,7)
  105.       if (achek.ne.aletv) go to 300
  106.       call find(avsrc,id,loct,0)
  107.       call find(avsrc,9,nodplc(loct+2),0)
  108.       nodplc(loct+5)=1
  109.       go to 400
  110. c
  111. c  noise or distortion outputs
  112. c
  113.   200 id=44
  114.       if (ktype.ge.4) id=id+1
  115.       if (value(idelim+ifld).ne.alprn) go to 220
  116.       if (nodplc(icode+ifld+1).ne.1) go to 300
  117.       ifld=ifld+1
  118.       atype=value(ifield+ifld)
  119.       call move(atype,2,ablnk,1,7)
  120.       do 210 i=1,5
  121.       if (atype.ne.aopts(i)) go to 210
  122.       ltype=i+1
  123.       go to 220
  124.   210 continue
  125.       go to 300
  126.   220 call find(anam,id,loct,0)
  127.       nodplc(loct+2)=0
  128.       nodplc(loct+5)=ktype
  129.       go to 400
  130. c
  131. c  errors
  132. c
  133.   300 igoof=1
  134. c
  135. c  finished
  136. c
  137.   400 return
  138.       end
  139.